#!/usr/bin/env wish
#-*-tcl-*-

set border 5
set unit 15;			# Unit length
set margin 2;			# Margin
set delay 200;			# Delay between steps
set pink "#faa";		# Pink colour for highlight

canvas .c -background white \
    -height [expr {9*$unit+2*$border}]m -width [expr {9*$unit+2*$border}]m
pack .c
frame .butbar
button .pause -text Step -command step
button .run -text Run -command run
button .reset -text Reset -command reset
button .quit -text Quit -command exit
pack .pause .run .reset .quit -in .butbar -side left
pack .butbar
bind . q exit

# Create grid
set aa $border; set bb [expr {9*$unit+$border}]
for {set i 0} {$i <= 9} {incr i} {
    set cc [expr {$i*$unit+$border}]
    set w [expr {($i % 3 == 0) + 1}]
    .c create line ${cc}m ${aa}m ${cc}m ${bb}m -width $w
    .c create line ${aa}m ${cc}m ${bb}m ${cc}m -width $w
}

# Create cells
for {set i 1} {$i <= 9} {incr i} {
    set aa [expr {($i-0.5)*$unit+$border}]
    for {set j 1} {$j <= 9} {incr j} {
	set bb [expr {($j-0.5)*$unit+$border}]
	set cell($i,$j) \
	    [.c create text ${aa}m ${bb}m -font "Sans 24" -tag _CELL_]
    }
}

proc init {} {
    global solving newc running ticks
    set solving 0
    set newc black
    set running 0
    set ticks 0
}

### Commands from the client

proc ready {} {
    global solving newc
    set solving 1
    set newc red
    .c itemconfigure _NEW_ -tag _CELL_
    .c delete _AREA_
    pause
}

proc place {level y x d k n col} {
    global cell solving newc
    if {$solving && $n > 1} {
	.c itemconfigure $cell($x,$y) -text $d -fill green
    } else {
	.c itemconfigure $cell($x,$y) -text $d -tag {_NEW_ _CELL_} -fill $newc
    }
    showarea $col
}

proc dead {col} {
    showarea $col
}

proc showarea {col} {
    global unit border margin pink

    set inset 0

    if {[regexp {Q(.)(.)} $col _ y x]} {
	set x1 [expr {($x-1)*$unit+$border+$inset}]
	set y1 [expr {($y-1)*$unit+$border+$inset}]
	set x2 [expr {$x*$unit+$border-$inset}]
	set y2 [expr {$y*$unit+$border-$inset}]
    } elseif {[regexp {R(.).} $col _ y]} {
	set x1 [expr {$border+$inset}]
	set y1 [expr {($y-1)*$unit+$border+$inset}]
	set x2 [expr {9*$unit+$border-$inset}]
	set y2 [expr {$y*$unit+$border-$inset}]
    } elseif {[regexp {C(.).} $col _ x]} {
	set x1 [expr {($x-1)*$unit+$border+$inset}]
	set y1 [expr {$border+$inset}]
	set x2 [expr {$x*$unit+$border-$inset}]
	set y2 [expr {9*$unit+$border-$inset}]
    } elseif {[regexp {B(.).} $col _ k]} {
	set p [expr {($k-1) % 3}]
	set q [expr {($k-1) / 3}]
	set x1 [expr {3*$p*$unit+$border+$inset}]
	set y1 [expr {3*$q*$unit+$border+$inset}]
	set x2 [expr {3*($p+1)*$unit+$border-$inset}]
	set y2 [expr {3*($q+1)*$unit+$border-$inset}]
    } else {
	return
    }

    .c lower [.c create rectangle ${x1}m ${y1}m ${x2}m ${y2}m \
		  -fill $pink -width 0 -tag _AREA_]
}

proc blocker {y x} {
    global unit border margin
    set x1 [expr {($x-1)*$unit+$border+$margin}]
    set y1 [expr {($y-1)*$unit+$border+$margin}]
    set x2 [expr {$x*$unit+$border-$margin}]
    set y2 [expr {$y*$unit+$border-$margin}]
    .c create oval ${x1}m ${y1}m ${x2}m ${y2}m -outline red -width 2 \
	-tag _BLOCK_
}

proc pause {} {
    global pipe delay running ticks signal

    update idletasks
    fileevent $pipe readable ""
    if {$running} {
	after $delay revive
    } else {
	while {! $running && $ticks == 0} {
	    vwait signal
	}
	if {! $running} {incr ticks -1}
	revive
    }
}

proc revive {} {
    global pipe

    .c itemconfigure _NEW_ -fill darkblue -tag _CELL_
    .c delete _BLOCK_
    .c delete _AREA_
    fileevent $pipe readable command
}

proc solution {} {
    pause
}

proc pop {level y x} {
    global cell
    .c itemconfigure $cell($x,$y) -text ""
}

## End of client commands

## GUI commands

proc step {} {
    global running ticks signal
    if {$running} {
	set running 0
	set ticks 0
    } else {
	incr ticks
	incr signal
    }
}

proc run {} {
    global running signal
    set running 1
    incr signal
}

proc command {} {
    global pipe

    if {[eof $pipe]} {
	close $pipe
	unset pipe
    } else {
	gets $pipe line
	eval $line
    }
}

proc reset {} {
    global cmd pipe

    if {[info exists pipe]} {close $pipe}

    init
    .c itemconfigure _CELL_ -text ""
    .c delete _AREA_
    .c delete _BLOCK_

    set pipe [open "|$cmd" r]
    fileevent $pipe readable command
}

set flags ""

if {[lindex $argv 0] eq "-q"} {
    set flags "-q"
    set argv [lrange $argv 1 end]
}

init
set puzz [lindex $argv 0]
set cmd "./sudoku $flags <$puzz"
set pipe [open "|$cmd" r]
fileevent $pipe readable command
